30-exploration

Exploration of how West Regions related to presonal and ecomnomic freedom

summary(hfi_west)

      year           x1               region          pf_ss_women_fgm pf_ss_women_missing pf_ss_women_inheritance_widows
 Min.   :2016   Length:42          Length:42          Min.   :10      Min.   : 7.500      Min.   : 5.000                
 1st Qu.:2016   Class :character   Class :character   1st Qu.:10      1st Qu.:10.000      1st Qu.:10.000                
 Median :2016   Mode  :character   Mode  :character   Median :10      Median :10.000      Median :10.000                
 Mean   :2016                                         Mean   :10      Mean   : 9.817      Mean   : 9.146                
 3rd Qu.:2016                                         3rd Qu.:10      3rd Qu.:10.000      3rd Qu.:10.000                
 Max.   :2016                                         Max.   :10      Max.   :10.000      Max.   :10.000                
                                                      NA's   :2       NA's   :1           NA's   :1                     
 pf_ss_women_inheritance_daughters pf_ss_women_inheritance  pf_ss_women     pf_movement_women personal_freedom
 Min.   : 5.000                    Min.   : 5.000          Min.   : 7.500   Min.   : 5.000    Min.   :5.710   
 1st Qu.:10.000                    1st Qu.:10.000          1st Qu.:10.000   1st Qu.:10.000    1st Qu.:8.185   
 Median :10.000                    Median :10.000          Median :10.000   Median :10.000    Median :8.795   
 Mean   : 9.268                    Mean   : 9.207          Mean   : 9.675   Mean   : 9.878    Mean   :8.499   
 3rd Qu.:10.000                    3rd Qu.:10.000          3rd Qu.:10.000   3rd Qu.:10.000    3rd Qu.:9.070   
 Max.   :10.000                    Max.   :10.000          Max.   :10.000   Max.   :10.000    Max.   :9.400   
 NA's   :1                         NA's   :1               NA's   :1        NA's   :1                         
 economic_freedom
 Min.   :5.980   
 1st Qu.:7.152   
 Median :7.525   
 Mean   :7.386   
 3rd Qu.:7.705   
 Max.   :8.390   
                 

# Montengro is the only western country without data for these varaibles
hfi_west <- hfi_west[-which(hfi_west$x1 == "Montenegro"),]
cor(hfi_west[5:12], hfi_west$personal_freedom)

                                       [,1]
pf_ss_women_missing               0.4228775
pf_ss_women_inheritance_widows    0.3806749
pf_ss_women_inheritance_daughters 0.3187086
pf_ss_women_inheritance           0.3771018
pf_ss_women                       0.4448413
pf_movement_women                 0.1658687
personal_freedom                  1.0000000
economic_freedom                  0.7534628

hfi_west %>%
  ggplot(aes(region, personal_freedom)) + geom_boxplot()

hfi_west %>%
  ggplot(aes(region, economic_freedom)) + geom_boxplot()

Time Series

#head(filteredchange)
filteredchange %>%
  ggplot(aes(x = year, y = pf_ss, group = countries)) +
  geom_line(alpha = 0.2, size = 0.1) +
  labs(title = "Countries with the Largest Positive Change in Safety and Security in Any Given Year",
       x = "Year",
       y = "Saftey and Security Score") +
  theme_light() +
  geom_line(data = subset(filteredchange, countries %in% inc_ss), aes(color = countries), size = 1.5, alpha = 0.7)

#filteredchange %>% filter(countries %in% inc_ss, year == 2016) %>% group_by(region) %>% summarize(mean = mean(pf_ss), n = n())
filteredchange %>%
  ggplot(aes(x = year, y = pf_ss, group = countries)) +
  geom_line(alpha = 0.2, size = 0.1) +
  labs(title = "Countries with the Largest Negative Change in Safety and Security in Any Given Year",
       x = "Year",
       y = "Saftey and Security Score") +
  theme_light() +
  geom_line(data = subset(filteredchange, countries %in% dec_ss), aes(color = countries), size = 1.5, alpha = 0.7)

#filteredchange %>% filter(countries %in% dec_ss, year == 2016) %>% group_by(region) %>% summarize(mean = mean(pf_ss), n = n())
filteredchange %>%
  ggplot(aes(x = year, y = pf_ss_women, group = countries)) +
  geom_line(alpha = 0.2, size = 0.1) +
  labs(title = "Countries with the Largest Positive Change in Women's Safety and Security in Any Given Year",
       x = "Year",
       y = "Women's Saftey and Security Score") +
  theme_light() +
  geom_line(data = subset(filteredchange, countries %in% inc_ss_women), aes(color = countries), size = 1.5, alpha = 0.7)

filteredchange %>%
  ggplot(aes(x = year, y = pf_ss_women, group = countries)) +
  geom_line(alpha = 0.2, size = 0.1) +
  labs(title = "Countries with the Largest Negative Change in Women's Safety and Security in Any Given Year",
       x = "Year",
       y = "Women's Saftey and Security Score") +
  theme_light() +
  geom_line(data = subset(filteredchange, countries %in% dec_ss_women), aes(color = countries), size = 1.5, alpha = 0.7)

data_by_year %>%
  ggplot(aes(x = year, y = avg_pf_ss, group = region)) +
  geom_line(aes(color = region), size = 1.25, alpha = 0.5) +
  labs(title = "Average Safety and Security by Region", x = "Year", y = "Safety and Security Score", fill = "Region") +
  scale_y_continuous(breaks = seq(6,10,0.5)) +
  theme_light() 

data_by_year %>%
  ggplot(aes(x = year, y = avg_pf_ss_women, group = region)) +
  geom_line(aes(color = region), size = 1.25, alpha = 0.5) +
  labs(title = "Average Safety and Security of Women by Region", x = "Year", y = "Safety and Security Score", fill = "Region") +
  scale_y_continuous(breaks = seq(6,10,0.5)) +
  theme_light()

data_by_year %>%
  filter(year == 2016, region %in% c("North America", "Western Europe", "Eastern Europe", "Latin America & the Caribbean")) %>%
  select(region, avg_pf_ss, avg_pf_ss_women) %>% melt %>%
  ggplot(aes(region, value, fill = variable)) + geom_bar(stat = "identity", position = "dodge") +
  labs(x = "Region", y = "Safety and Security Score", title = "2016 Overall and Women's Safety and Security By Region (Western Hemisphere)", fill = "Variable") + scale_fill_manual(labels = c("Average Overall Security", "Average Women's Security"), values = c("Red", "Blue"))

Using region as id variables

data_by_year %>%
  filter(year == 2016, region %in% c("South Asia", "Oceania", "East Asia", "Caucasus & Central Asia", "Middle East & North Africa", "Sub-Saharan Africa")) %>%
  select(region, avg_pf_ss, avg_pf_ss_women) %>% melt %>%
  ggplot(aes(region, value, fill = variable)) + geom_bar(stat = "identity", position = "dodge") +
  labs(x = "Region", y = "Safety and Security Score", title = "2016 Overall and Women's Safety and Security By Region (Eastern Hemishpere)", fill = "Variable") + scale_fill_manual(labels = c("Average Overall Security", "Average Women's Security"), values = c("Red", "Blue"))

Using region as id variables

#unique(data_by_year$region)
  

ggplot(data = hfi16, aes(x = pf_score, y = ef_score)) + 
  geom_point(aes(col = pf_ss_women)) +
  labs(x = "Personal Freedom Score", y = "Economic Freedom Score", main = "Personal and Economic Freedom and Women Security", color = "Security of Women")

# light grey boundaries
l <- list(color = toRGB("grey"), width = 0.9)
# specify map projection/options
g <- list(
showframe = FALSE,
showcoastlines = FALSE,
projection = list(type = 'Mercator')
)
plot_geo(score16) %>%
add_trace(
z = ~ round(hf_score, 2), color = ~hf_score, colors = 'Blues', 
text = ~countries, locations = ~ISO_code, marker = list(line = l)) %>%
colorbar(title = 'Human Freedom \nScore, 2016') %>%
layout(
title = 'Human Freedom Score, 2016',
geo = g
)

l <- list(color = toRGB("grey"), width = 0.9)
# specify map projection/options
g <- list(
showframe = FALSE,
showcoastlines = FALSE,
projection = list(type = 'Mercator')
)
plot_geo(score08) %>%
add_trace(
z = ~ round(hf_score, 2), color = ~hf_score, colors = 'Blues', 
text = ~countries, locations = ~ISO_code, marker = list(line = l)) %>%
colorbar(title = 'Human Freedom \nScore, 2008') %>%
layout(
title = 'Human Freedom Score, 2008',
geo = g
)

ggplotchange <- ggplot(data = map.world.change, aes(x = long, y = lat, group= group, fill = human_freedom_score, text =  paste("country:", region, "<br>", "personal_freedom_score:", personal_freedom_score, "<br>", "personal_freedom_rank:", personal_freedom_rank, "<br>", "economy_freedom_score:", economy_freedom_score, "<br>", "economy_freedom_rank:", economy_freedom_rank, "<br>", "human_freedom_score:", human_freedom_score, "<br>", "human_freedom_rank:", human_freedom_rank))) +
  geom_polygon() +
  scale_fill_gradient2(low = "#383C46", high = "#D4DBEA", mid="#5A76AF", name="Change of \nFreedom Score") +
  theme(panel.background =  element_rect(fill = "white", colour = "grey50"),
        panel.grid = element_blank(),
        axis.text = element_blank(),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        legend.justification = "top",
        plot.title = element_text(hjust = 0.5)) +
  labs(title = "Changes from 2008 to 2016") #+
  #guides(fill = guide_legend(title=NULL))
ggplotly(ggplotchange, tooltip = c("text"))

str(score16)

Classes ‘tbl_df’, ‘tbl’ and 'data.frame':   162 obs. of  9 variables:
 $ ISO_code : chr  "ALB" "DZA" "AGO" "ARG" ...
 $ countries: chr  "Albania" "Algeria" "Angola" "Argentina" ...
 $ region   : chr  "Eastern Europe" "Middle East & North Africa" "Sub-Saharan Africa" "Latin America & the Caribbean" ...
 $ pf_score : num  7.6 5.28 6.11 8.1 6.91 ...
 $ pf_rank  : num  57 147 117 42 84 11 8 131 64 114 ...
 $ ef_score : num  7.54 4.99 5.17 4.84 7.57 7.98 7.58 6.49 7.34 7.56 ...
 $ ef_rank  : num  34 159 155 160 29 10 27 106 49 30 ...
 $ hf_score : num  7.57 5.14 5.64 6.47 7.24 ...
 $ hf_rank  : num  48 155 142 107 57 4 16 130 50 75 ...

p <- ggplot(score16, aes(x=hf_score ,y=reorder(countries,hf_rank))) + 
  geom_point(colour = "red", alpha = .5) + 
  geom_segment(aes(yend=reorder(countries,hf_rank)), xend = 0, colour="pink", alpha = .5) + 
  theme(axis.text.y = element_text(angle = 0, hjust = 1)) + 
  labs(title = "World Human Freedom Rank in 2016", y = "Country Name", x = "Human Freedom Rank")
ggplotly(p)

score = hfi %>% filter(year == 2016) %>% select(pf_ss_women, ISO_code, countries, region, pf_score, pf_rank, ef_score, ef_rank, hf_score, hf_rank) %>%  na.omit()
p1 =ggplot(score, aes(x = ef_score, y = pf_score, color = region), group = countries)
pointsToLabel <- c("Russia", "Venezuela", "Iraq", "Myanmar", "Sudan",
                   "Afghanistan", "Congo", "Greece", "Argentina", "Brazil",
                   "India", "Italy", "China", "South Africa", "Spain",
                   "Botswana", "Cape Verde", "Bhutan", "Rwanda", "France",
                   "United States", "Germany", "Britain", "Barbados", "Norway", "Japan",
                   "New Zealand", "Singapore")
mR2 <- summary(lm(pf_score ~ 1 + ef_score , data = score))$r.squared
mR2 <- paste0(format(mR2, digits = 2))
p2 = p1 + geom_smooth(mapping = aes(linetype = "r2"),
              method = "lm",se = FALSE,
              color = "red") + # geom_point(size = 2, stroke = 1.25) +
  geom_point(aes(size = round(pf_ss_women)), alpha = 0.6)+ labs(size = "Women Security Score") + 
  geom_text_repel(aes(label = countries) , color = "black", size = 2.5, data = filter(score, countries %in% pointsToLabel), force = 2 ) + #check_overlap = TRUE
  scale_x_continuous(name = "Economic Freedom Score, 2016 (10 = Most Free)", limits = c(2.5,9.5), breaks = 2.5:9.5) +
  scale_y_continuous(name = "Personal Freedom Score, 2016 (10 = Most Free)", limits = c(2.5,9.5), breaks = 2.5:9.5) +
  scale_color_brewer(name = "" , type = 'div', palette = 'Spectral') +
  scale_linetype(name = "",
                 breaks = "r2",
                 labels = list(bquote(R^2==.(mR2))),
                 guide = guide_legend(override.aes = list(linetype = 1, size = 2, color = "red"), order=2)) +
  ggtitle("Economic & Personal Freedom and Women Security 2016") +
  theme_minimal() + # start with a minimal theme and add what we need
  theme(text = element_text(color = "gray20"),
        legend.text = element_text(size = 10, color = "gray10"),
        axis.text = element_text(face = "italic"),
        axis.title.x = element_text(vjust = -1), # move title away from axis
        axis.title.y = element_text(vjust = 2), # move away for axis
        axis.ticks.y = element_blank(), # element_blank() is how we remove elements
        axis.line = element_line(color = "gray40", size = 0.3),
        #panel.grid.major = element_blank()
        #axis.line.y = element_blank()
        panel.grid.major = element_line(color = "gray", size = 0.2)
        #panel.grid.major.x = element_blank()
        )
  
suppressWarnings(print(p2))

df = hfi %>% filter(year == 2008) %>% select(year, ISO_code, countries, region, starts_with('pf_'))
df=df[,colSums(is.na(df))<nrow(df)]
df = df %>% na.omit()
cormat <- round(cor(df[,5:57]),2)
#
get_lower_tri<-function(cormat){
  cormat[upper.tri(cormat)] <- NA
  return(cormat)
}
get_upper_tri <- function(cormat){
  cormat[lower.tri(cormat)]<- NA
  return(cormat)
}
reorder_cormat <- function(cormat){
  # Use correlation between variables as distance
  dd <- as.dist((1-cormat)/2) 
  hc <- hclust(dd)
  cormat <-cormat[hc$order, hc$order]
}

cormat <- reorder_cormat(cormat)
upper_tri <- get_upper_tri(cormat)
# Melt the correlation matrix
melted_cormat <- melt(upper_tri, na.rm = TRUE)
# Create a ggheatmap
ggheatmap <- ggplot(melted_cormat, aes(Var2, Var1, fill = value))+
  geom_tile(color = "white")+
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", 
                       midpoint = 0, limit = c(-1,1), space = "Lab", 
                       name="Pearson\nCorrelation") +
  theme_minimal()+ # minimal theme
  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                   size = 8.5, hjust = 1), 
        panel.grid.major = element_line(color = "gray", size = 0.2)) +
  coord_fixed()
ggheatmap + 
  theme(
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    panel.grid.major = element_line(color = "gray", size = 0.2),
    panel.border = element_blank(),
    panel.background = element_blank(),
    axis.ticks = element_blank()
    ) + ggtitle("Personal Freedom, 2008")

hfi16 = hfi[hfi$year == 2016,]
hfi16 <- hfi16 %>% select(year, X1 = countries, region, pf_ss, pf_rol, pf_religion, pf_association, pf_identity, pf_expression, pf_score, pf_movement, ef_government, ef_legal, ef_score, ef_regulation, ef_money, ef_trade, contains("women"), pf_identity_sex_female, pf_identity_divorce)
hfi16 <- hfi16[-which(is.na(hfi16[4:26])),] %>% na.omit()
set.seed(1235) 
clusters <- hfi16 %>% select(contains("women")) %>% na.omit()
k3 <- kmeans(clusters, 3)
k3

K-means clustering with 3 clusters of sizes 48, 26, 58

Cluster means:
  pf_ss_women_fgm pf_ss_women_missing pf_ss_women_inheritance_widows pf_ss_women_inheritance_daughters
1        9.018750            9.010417                      5.3125000                         5.1041667
2        8.684615            7.884615                      0.1923077                         0.1923077
3       10.000000            9.655172                      9.7413793                         9.9137931
  pf_ss_women_inheritance pf_ss_women pf_movement_women
1               5.2083333    7.745833          7.812500
2               0.1923077    5.587179          3.653846
3               9.8275862    9.827586          9.568966

Clustering vector:
  [1] 1 2 1 3 3 3 3 1 2 2 3 3 1 1 1 1 3 1 2 3 1 3 1 2 1 1 3 1 3 1 3 3 3 3 3 3 2 3 3 1 3 3 1 1 3 1 1 3 1 1 1 3 3 3 1 1 2 2
 [59] 3 3 3 3 3 2 3 1 3 2 1 3 2 2 3 3 1 1 2 1 2 1 1 1 3 2 1 2 1 3 3 3 1 2 2 3 2 2 3 1 1 1 3 3 2 3 3 1 2 1 3 1 3 3 3 3 1 2
[117] 3 3 1 2 1 1 2 3 1 3 2 3 3 1 3 1

Within cluster sum of squares by cluster:
[1] 902.7201 557.8034 298.1801
 (between_SS / total_SS =  78.2 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss" "betweenss"    "size"        
[8] "iter"         "ifault"      

fviz_cluster(k3, data = clusters)

fviz_nbclust(clusters, kmeans, method = "wss")

hfi16$clusters <- as.factor(k3$cluster)
hfi16$regionf <- factor(hfi16$region)

corr <- round(cor(na.omit(hfi16[4:26])), 1)
ggcorrplot(corr, hc.order = TRUE, method = "circle", lab = TRUE, lab_size = 3)

hfi16 <- hfi16 %>%
  group_by(clusters) %>%
  mutate(clusteravgwss = mean(pf_ss_women), clustersdwss = sd(pf_ss_women), clusteravgss = mean(pf_ss), clustersdss = sd(pf_ss))

ggplot(data = hfi16, aes(y = pf_ss_women, x = pf_religion)) +
  scale_shape_manual(values = 1:nlevels(hfi16$regionf)) +
  geom_jitter(aes(color = clusters, shape = regionf)) +
  labs(col = "Clusters",
       shape = "Regions",
       x = "Religious Freedom",
       y = "Security of Women") +
  geom_text_repel(
    data = subset(hfi16, pf_ss_women  < (clusteravgwss - clustersdwss)),
    aes(
      x = pf_religion,
      y = pf_ss_women,
      label = X1,
      color =
        clusters
    ),
    nudge_y = .5
  )

ggplot(data = hfi16, aes(y = pf_ss_women, x = pf_rol)) +
  scale_shape_manual(values = 1:nlevels(hfi16$regionf)) +
  geom_jitter(aes(color = clusters, shape = regionf)) +
  labs(col = "Clusters",
       shape = "Regions",
       x = "Rule of Law",
       y = "Security of Women") +
  geom_text_repel(
    data = subset(hfi16, pf_ss_women  < (clusteravgwss - clustersdwss)),
    aes(
      x = pf_rol,
      y = pf_ss_women,
      label = X1,
      color =
        clusters
    ),
    nudge_y = .5
  )

ggplot(data = hfi16, aes(y = pf_ss_women, x = ef_score)) +
  scale_shape_manual(values = 1:nlevels(hfi16$regionf)) +
  geom_jitter(aes(color = clusters, shape = regionf)) +
  labs(col = "Clusters",
       shape = "Regions",
       x = "Economic Freedom Score",
       y = "Security of Women") +
  geom_text_repel(
    data = subset(hfi16, pf_ss_women  < (clusteravgwss - clustersdwss)),
    aes(
      x = ef_score,
      y = pf_ss_women,
      label = X1,
      color =
        clusters
    ),
    nudge_y = .5
  )

ggplot(data = hfi16, aes(y = pf_ss_women, x = ef_money)) +
  scale_shape_manual(values = 1:nlevels(hfi16$regionf)) +
  geom_jitter(aes(color = clusters, shape = regionf)) +
  labs(col = "Clusters",
       shape = "Regions",
       x = "Access to Sound Money",
       y = "Security of Women") +
  geom_text_repel(
    data = subset(hfi16, pf_ss_women  < (clusteravgwss - clustersdwss)),
    aes(
      x = ef_money,
      y = pf_ss_women,
      label = X1,
      color =
        clusters
    ),
    nudge_y = .5
  )

ggplot(data = hfi16, aes(y = pf_ss_women, x = pf_identity)) +
  scale_shape_manual(values = 1:nlevels(hfi16$regionf)) +
  geom_jitter(aes(color = clusters, shape = regionf)) +
  labs(col = "Clusters",
       shape = "Regions",
       x = "Access to Divorce",
       y = "Security of Women") +
  geom_text_repel(
    data = subset(hfi16, pf_ss_women  < (clusteravgwss - clustersdwss)),
    aes(
      x = pf_identity,
      y = pf_ss_women,
      label = X1,
      color =
        clusters
    ), nudge_y = .5
  )

ggplot(data = hfi16, aes(y = pf_ss_women, x = pf_score)) +
  scale_shape_manual(values = 1:nlevels(hfi16$regionf)) +
  geom_jitter(aes(color = clusters, shape = regionf)) +
  labs(col = "Clusters",
       shape = "Regions",
       x = "Personal Freedom Score",
       y = "Security of Women") +
  geom_text_repel(
    data = subset(hfi16, pf_ss_women  < (clusteravgwss - clustersdwss)),
    aes(
      x = pf_score,
      y = pf_ss_women,
      label = X1,
      color =
        clusters
    ), nudge_y = .5
  )

ggplot(data = hfi16, aes(y = pf_ss_women, x = pf_ss)) +
  scale_shape_manual(values = 1:nlevels(hfi16$regionf)) +
  geom_jitter(aes(color = clusters, shape = regionf)) +
  labs(col = "Clusters",
       shape = "Regions",
       x = "General Security",
       y = "Security of Women") +
  geom_text_repel(
    data = subset(hfi16, pf_ss  < (clusteravgss - clustersdss)),
    aes(
      x = pf_ss,
      y = pf_ss_women,
      label = X1,
      color =
        clusters
    ), nudge_y = .5
  )

perc <- hfi16 %>% group_by(clusters) %>% mutate(ninclust = n()) %>% ungroup()
perc <- perc %>% group_by(region) %>% mutate(ninregion = n()) %>% ungroup()

hfi16 %>% 
  select(X1,clusters)

# light grey boundaries
l <- list(color = clusters, width = 0.5)
# specify map projection/options
g <- list(
showframe = TRUE,
showcoastlines = TRUE,
scope="world",
projection = list(type = 'Mercator')
)

hfi16$clusters <- as.factor(hfi16$clusters)
plot_geo(hfi16) %>%
add_trace(z = ~clusters,
text = ~X1, locations = ~ISO_code, marker = list(line = l,inherit = TRUE)
) %>%
colorbar(title="") %>% 
layout(
title = 'Women Freedom Clusters World Map',
geo = g
)

Error in eval(expr, data, expr_env) : object 'ISO_code' not found